﻿Imports System.Runtime.InteropServices
Imports Microsoft.VisualBasic.FileIO

Class ResolutionComparer
    Implements IComparer(Of Resolution)

    Function ResCompare(a As Resolution, b As Resolution) As Integer Implements IComparer(Of Resolution).Compare
        If a.width > b.width Then Return -1
        If a.width < b.width Then Return 1

        If a.height > b.height Then Return -1
        If a.height < b.height Then Return 1

        Return 0
    End Function
End Class

Friend Class Resolution
    Friend width As Integer
    Friend height As Integer

    Sub New(ByVal w As Integer, ByVal h As Integer)
        width = w
        height = h
    End Sub

    Overrides Function ToString() As String
        Return width.ToString & " x " & height.ToString
    End Function

    Private Const CCDEVICENAME As Integer = 32
    Private Const CCFORMNAME As Integer = 32

    <StructLayout(LayoutKind.Sequential)>
    Private Structure DEVMODE
        <MarshalAsAttribute(UnmanagedType.ByValTStr, SizeConst:=CCDEVICENAME)> Public dmDeviceName As String
        Public dmSpecVersion As Short
        Public dmDriverVersion As Short
        Public dmSize As Short
        Public dmDriverExtra As Short
        Public dmFields As Integer

        Public dmOrientation As Short
        Public dmPaperSize As Short
        Public dmPaperLength As Short
        Public dmPaperWidth As Short

        Public dmScale As Short
        Public dmCopies As Short
        Public dmDefaultSource As Short
        Public dmPrintQuality As Short
        Public dmColor As Short
        Public dmDuplex As Short
        Public dmYResolution As Short
        Public dmTTOption As Short
        Public dmCollate As Short
        <MarshalAsAttribute(UnmanagedType.ByValTStr, SizeConst:=CCFORMNAME)> Public dmFormName As String
        Public dmUnusedPadding As Short
        Public dmBitsPerPel As Short
        Public dmPelsWidth As Integer
        Public dmPelsHeight As Integer

        Public dmDisplayFlags As Integer
        Public dmDisplayFrequency As Integer
    End Structure

    Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Integer, ByVal iModeNum As Integer, ByRef lpdmode As DEVMODE) As Boolean

    Shared Sub AddResolution(ByVal w As Integer, ByVal h As Integer, ByRef lst As List(Of Resolution))
        For Each r As Resolution In lst
            If (w = r.width AndAlso h = r.height) Then Exit Sub
        Next
        lst.Add(New Resolution(w, h))
    End Sub

    Shared Function GetResolution() As List(Of Resolution)
        Dim DevM As DEVMODE
        DevM.dmDeviceName = New [String](New Char(32) {})
        DevM.dmFormName = New [String](New Char(32) {})
        DevM.dmSize = CShort(Marshal.SizeOf(GetType(DEVMODE)))

        Dim dMode = 0
        Dim resList As List(Of Resolution) = New List(Of Resolution)

        Do While EnumDisplaySettings(Nothing, dMode, DevM) = True
            If (DevM.dmBitsPerPel = 32 AndAlso DevM.dmPelsWidth >= 640 AndAlso DevM.dmPelsHeight >= 480) Then
                AddResolution(DevM.dmPelsWidth, DevM.dmPelsHeight, resList)

                'DebugRes(DevM)
            End If
            dMode += 1
        Loop

        resList.Sort(New ResolutionComparer)

        Return resList
    End Function

    Shared Sub ResolutionAddToList(ByVal scaleX2 As Boolean, ByVal list As ListBox)
        list.Items.Clear()
        If scaleX2 Then
            For Each r As Resolution In Resolution.GetResolution
                If (r.height >= 960 AndAlso r.width >= 1280) Then
                    list.Items.Add(r)
                End If
            Next
        Else
            list.Items.AddRange(Resolution.GetResolution.ToArray)
        End If
    End Sub

#If DEBUG Then
    Private Shared Sub DebugRes(ByVal DevM As DEVMODE)
        FileSystem.WriteAllText("sConf.dbg", "DevM.dmBitsPerPel:", True)
        FileSystem.WriteAllText("sConf.dbg", DevM.dmBitsPerPel, True)
        FileSystem.WriteAllText("sConf.dbg", vbCrLf & "DevM.dmCollate:", True)
        FileSystem.WriteAllText("sConf.dbg", DevM.dmCollate, True)
        FileSystem.WriteAllText("sConf.dbg", vbCrLf & "DevM.dmColor:", True)
        FileSystem.WriteAllText("sConf.dbg", DevM.dmColor, True)
        FileSystem.WriteAllText("sConf.dbg", vbCrLf & "DevM.dmCopies:", True)
        FileSystem.WriteAllText("sConf.dbg", DevM.dmCopies, True)
        FileSystem.WriteAllText("sConf.dbg", vbCrLf & "DevM.dmDefaultSource:", True)
        FileSystem.WriteAllText("sConf.dbg", DevM.dmDefaultSource, True)
        FileSystem.WriteAllText("sConf.dbg", vbCrLf & "DevM.dmDeviceName:", True)
        FileSystem.WriteAllText("sConf.dbg", DevM.dmDeviceName, True)
        FileSystem.WriteAllText("sConf.dbg", vbCrLf & "DevM.dmDisplayFlags:", True)
        FileSystem.WriteAllText("sConf.dbg", DevM.dmDisplayFlags, True)
        FileSystem.WriteAllText("sConf.dbg", vbCrLf & "DevM.dmDisplayFrequency:", True)
        FileSystem.WriteAllText("sConf.dbg", DevM.dmDisplayFrequency, True)
        FileSystem.WriteAllText("sConf.dbg", vbCrLf & "DevM.dmDriverExtra:", True)
        FileSystem.WriteAllText("sConf.dbg", DevM.dmDriverExtra, True)
        FileSystem.WriteAllText("sConf.dbg", vbCrLf & "DevM.dmDriverVersion:", True)
        FileSystem.WriteAllText("sConf.dbg", DevM.dmDriverVersion, True)
        FileSystem.WriteAllText("sConf.dbg", vbCrLf & "DevM.dmDuplex:", True)
        FileSystem.WriteAllText("sConf.dbg", DevM.dmDuplex, True)
        FileSystem.WriteAllText("sConf.dbg", vbCrLf & "DevM.dmFields:", True)
        FileSystem.WriteAllText("sConf.dbg", DevM.dmFields, True)
        FileSystem.WriteAllText("sConf.dbg", vbCrLf & "DevM.dmFormName:", True)
        FileSystem.WriteAllText("sConf.dbg", DevM.dmFormName, True)
        FileSystem.WriteAllText("sConf.dbg", vbCrLf & "DevM.dmOrientation:", True)
        FileSystem.WriteAllText("sConf.dbg", DevM.dmOrientation, True)
        FileSystem.WriteAllText("sConf.dbg", vbCrLf & "DevM.dmPaperLength:", True)
        FileSystem.WriteAllText("sConf.dbg", DevM.dmPaperLength, True)
        FileSystem.WriteAllText("sConf.dbg", vbCrLf & "DevM.dmPaperSize:", True)
        FileSystem.WriteAllText("sConf.dbg", DevM.dmPaperSize, True)
        FileSystem.WriteAllText("sConf.dbg", vbCrLf & "DevM.dmPaperWidth:", True)
        FileSystem.WriteAllText("sConf.dbg", DevM.dmPaperWidth, True)
        FileSystem.WriteAllText("sConf.dbg", vbCrLf & "DevM.dmPelsHeight:", True)
        FileSystem.WriteAllText("sConf.dbg", DevM.dmPelsHeight, True)
        FileSystem.WriteAllText("sConf.dbg", vbCrLf & "DevM.dmPelsWidth:", True)
        FileSystem.WriteAllText("sConf.dbg", DevM.dmPelsWidth, True)
        FileSystem.WriteAllText("sConf.dbg", vbCrLf & "DevM.dmPrintQuality:", True)
        FileSystem.WriteAllText("sConf.dbg", DevM.dmPrintQuality, True)
        FileSystem.WriteAllText("sConf.dbg", vbCrLf & "DevM.dmScale:", True)
        FileSystem.WriteAllText("sConf.dbg", DevM.dmScale, True)
        FileSystem.WriteAllText("sConf.dbg", vbCrLf & "DevM.dmSize:", True)
        FileSystem.WriteAllText("sConf.dbg", DevM.dmSize, True)
        FileSystem.WriteAllText("sConf.dbg", vbCrLf & "DevM.dmSpecVersion:", True)
        FileSystem.WriteAllText("sConf.dbg", DevM.dmSpecVersion, True)
        FileSystem.WriteAllText("sConf.dbg", vbCrLf & "DevM.dmTTOption:", True)
        FileSystem.WriteAllText("sConf.dbg", DevM.dmTTOption, True)
        FileSystem.WriteAllText("sConf.dbg", vbCrLf & "DevM.dmUnusedPadding:", True)
        FileSystem.WriteAllText("sConf.dbg", DevM.dmUnusedPadding, True)
        FileSystem.WriteAllText("sConf.dbg", vbCrLf & "DevM.dmYResolution:", True)
        FileSystem.WriteAllText("sConf.dbg", DevM.dmYResolution, True)
        FileSystem.WriteAllText("sConf.dbg", vbCrLf & vbCrLf, True)
    End Sub
#Else
    Private Shared Sub DebugRes(ByVal DevM As DEVMODE)
    End Sub
#End If

End Class
